Projekt analizy wyników badań PISA 2018 został wykonany w ramach przedmiotu Wstęp do eksploracji danych na Wydziale Matematyki i Nauk Informacyjnych Politechniki Warszawskiej. Celem projektu było zaznajomienie się z pakietem plot_ly wykorzystującym interaktywne wykresy do obrazowania danych statystycznych.
PISA jest miedzynarodowym badaniem umiejętności piętnastolatków w zakresie trzech obszarów:
Ma ono na celu sprawdzenie i porównanie jakości edukacji i przeprowadzane jest (z wyjątkiem przerwy spowodowanej pandemią COVID19) co 3 lata, w tym także w roku 2018. W tym badaniu wzięlo udział 79 krajów i regionów ze wszystkich zamieszkałych kontynentów. Z każego badania publikowane są szczegółowe wyniki dotyczące nie tylko rezultatów osiągniętych przez uczniów, ale też prezentujące ich styl życia, samopoczucie czy plany na przyszłość. Respondentami są - oprócz uczniów - także rodzice i dyrektorzy szkół.
W raporcie przeanalizowano dwa aspekty badań:
Wyniki obu analiz prezentowane są niżej w postaci interaktywnych wykresów.
Dane dotyczące wyników raportu zostały pobrane ze strony https://www.oecd.org/pisa/. Dane o wskaźnikach PKB per Capita dla roku 2018 wzięto ze stron https://countryeconomy.com/ i https://data.worldbank.org/.
library(plotly)
library(dplyr)
wyniki <- read.csv("wyniki.csv")
wyniki <- select(wyniki, -X)
#tworzenie wykresu
plot3d <- plot_ly(
data = wyniki,
x = ~Matematyka,
y = ~Nauki_Scisle,
z = ~Czytanie,
color = ~Kontynent,
colors = "Set1",
type = "scatter3d",
mode = "markers",
text = paste0("Kraj: ", wyniki$Kraj, "<br>Kontynent: ", wyniki$Kontynent),
hovertemplate = paste('<b>%{text}</b><br><b>Matematyka</b>: %{x}<br><b>Nauki Scisle</b>: %{y}<br><b>Czytanie</b>: %{z} <extra></extra>')
)
plot3d <- plot3d %>%
layout(title = list(text = "Wyniki padań PISA 2018 według krajów w 3 głównych obszarach, \nz podziałem na kontynenty", size = 15),
scene = list(xaxis = list(title = "Matematyka"),
yaxis = list(title = "Nauki Ścisłe"),
zaxis = list(title = "Czytanie")),
legend = list(title=list(text='<b> Kontynent </b>')))Kliknij na obszarze wykresu, aby go obrócić. Najedź kursorem na interesujący Cię punkt, aby wyświetlić szczegóły.
Punkty na powyższym wykresie są ułożone a miarę jednostajnie. Co więcej - nie widać znaczących odchyleń od głównej przekątnej, co może sugerować, że poszczególne kraje osiągały w każym z 3 obszarów badań wyniki zbliżone do siebie. Faktycznie, średnia różnica między najwyższym i najniższym wynikiem wynosi niecałe 18 punktów.
Jeśli spojrzymy na kontynenty, zauważymy silne rozwarstwienie w wynikach dla krajów azjatyckich, w przeciwieństwie do państw Ameryki Południowej. Dostrzec mozna też dużą grupę europejskich państw plasujących się w tuż za plecami azjatyckich liderów.
Obserwacje z powyższego wykresu pozwalają przypuszczać, że średnia liczba zdobytych punktów w 3 obszarach jest dobrym wskaźnikiem wyników kraju.
Wskaźnik PKB per Capita dotyczy roku 2018, w którym odbywało się badanie PISA.
wyniki <- wyniki %>%
mutate(kwartylPKB = ntile(PKBperCapita, 4))
qplot <- plot_ly(x = ~wyniki$srednia,
type = "box",
visible = T,
name = "Wszystkie kraje",
text = paste0("Kraj: ", wyniki$Kraj),
hovertemplate = paste('<b>%{text}</b><br><b>Średnia</b>: %{x} <extra></extra>'),
showlegend = F
)
qplot <- qplot %>%
add_trace(type = "box",
x = wyniki[wyniki$kwartylPKB==1,]$srednia,
name = "1. Kwartyl",
visible = T,
text = paste0("Kraj: ", wyniki[wyniki$kwartylPKB==1,]$Kraj),
hovertemplate = paste('<b>%{text}</b><br><b>Średnia</b>: %{x} <extra></extra>')) %>%
add_trace(type = "box",
x = wyniki[wyniki$kwartylPKB==2,]$srednia,
name = "2. kwartyl",
visible = F,
text = paste0("Kraj: ", wyniki[wyniki$kwartylPKB==2,]$Kraj),
hovertemplate = paste('<b>%{text}</b><br><b>Średnia</b>: %{x} <extra></extra>'))%>%
add_trace(type = "box",
x = wyniki[wyniki$kwartylPKB==3,]$srednia,
name = "3. kwartyl",
visible = F,
text = paste0("Kraj: ", wyniki[wyniki$kwartylPKB==3,]$Kraj),
hovertemplate = paste('<b>%{text}</b><br><b>Średnia</b>: %{x} <extra></extra>'))%>%
add_trace(type = "box",
x = wyniki[wyniki$kwartylPKB==4,]$srednia,
name = "4. kwartyl",
visible = F,
text = paste0("Kraj: ", wyniki[wyniki$kwartylPKB==4,]$Kraj),
hovertemplate = paste('<b>%{text}</b><br><b>Średnia</b>: %{x} <extra></extra>')) %>%
layout(
updatemenus = list(
list(
type = "list",
buttons = list(
list(method = "restyle",
args = list('visible', c(T,T,F,F,F)),
label = "1 kwartyl PKB"),
list(method = "restyle",
args = list('visible', c(T,F,T,F,F)),
label = "2 kwartyl PKB"),
list(method = "restyle",
args = list('visible', c(T,F,F,T,F)),
label = "3 kwartyl PKB"),
list(method = "restyle",
args = list('visible', c(T,F,F,F,T)),
label = "4 kwartyl PKB")
)
)
),
title = list(text = "Porównanie średniej liczby punktów krajów \n z wybranego kwartylu PKB per Capita \n względem wszystkich krajów"),
xaxis = list(title = "Średnia liczba punktów",
range = c(min(wyniki$srednia), max(wyniki$srednia))),
yaxis = list(title = "")
)Wybierz z rozwijanej listy interesujący Cię kwartyl, aby zobaczyć jak kształtuje się dotyczący go wykres skrzynkowy na tle wszystkich krajów. Dodatkowo, po najechaniu na punkt symbolizujący wartość odstającą (outlier) dowiesz się, jakie państwo symbolizuje.
Zauważalne jest przesuwanie się wykresu skrzynkowego w prawo wraz ze wzrostem numeru kwartyla, co oznacza, że im bardziej zamożne państwo, tym lepsze wyniki osiągaja uczniowie.
Wynik badania nie pozostawiają złudzeń - wyraźnie widać, że miejsce urodzenia ma wpływ na to jak będzie wyglądała nasza przyszłość. Kraje bogate, z wysokim wskaźnikiem PKB per Capita, na ogół posiadają lepszy system edukacji od krajów biedniejszych, choć warto pamiętać, że utrzymanie dobrej jakości nauczania w krajach bogatych na ogół kosztuje więcej, z uwagi na wyższe pensje nauczycieli i wydatków na cały aparat oświaty.
Pokrzepiającym dla nas Polaków faktem może być wysoki wynik Polski. Zajęliśmy 10. miejsce, ale porównując się do krajów z naszego kwartylu PKB per Capita ustępujemy tylko Chinom, które osiągneły najlepszy wynik na całym świecie, będąc zdecydowanym outlierem w swoim kwartylu. Z państw biedniejszych od nas o jedną pozycję wyżej plasuje się jedynie Wietnam, czyli kolejne państwo określanie potocznie mianem azjatyckiego tygrysa.